hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
## id house course sex wandCore bloodStatus result Defence against the …¹
## <dbl> <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl>
## 1 1 Ravencl… 4 fema… unicorn… half-blood 94 73
## 2 2 Hufflep… 5 male phoenix… half-blood 33 38
## 3 3 Ravencl… 4 fema… dragon … half-blood 137 52
## 4 4 Hufflep… 2 male phoenix… half-blood 27 50
## 5 5 Hufflep… 2 fema… phoenix… half-blood 67 47
## 6 6 Gryffin… 6 male phoenix… muggle-born 126 44
## # ℹ abbreviated name: ¹`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## # `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## # `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## # `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## # `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## # `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …
hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex <chr> "female", "male", "female", "male…
## $ wandCore <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus <chr> "half-blood", "half-blood", "half…
## $ result <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam` <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam` <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam` <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam` <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam` <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam` <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam` <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam` <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam` <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam` <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam` <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam` <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1 <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2 <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3 <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4 <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5 <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6 <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7 <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8 <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9 <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10 <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11 <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12 <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13 <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14 <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15 <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16 <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17 <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18 <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19 <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20 <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21 <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22 <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23 <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24 <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25 <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26 <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27 <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28 <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29 <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30 <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31 <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32 <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33 <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34 <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35 <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36 <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37 <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38 <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39 <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40 <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
# Changing some variables type to factors
hogwarts <- hogwarts |> mutate(
across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)
sum(is.na(hogwarts))
## [1] 0
theme_custom <- theme(
axis.text = element_text(size = 25),
axis.title = element_text(size = 25),
#axis.text.x = element_text(angle = 15),
legend.title = element_text(size = 20),
legend.text = element_text(size = 20)
)
ggplot(hogwarts)+
geom_bar(aes(x = course,
fill = course),
colour = "grey10") +
scale_fill_manual(values = c("1" = "grey100",
"2" = "grey90",
"3" = "grey70",
"4" = "grey50",
"5" = "grey40",
"5" = "grey30",
"7" = "grey20"))+
theme_minimal() +
theme_custom
bar_cust<-geom_bar(aes(x = fct_infreq(house),
fill = bloodStatus),
colour = "black",
position= "fill")
ggplot(hogwarts)+
bar_cust+
scale_x_discrete(name = "house")+
scale_y_continuous(labels = scales::percent) +
theme_minimal() +
theme_custom
Вывод: самые существеннве различия между факультетами по количеству
маглорожденных, при этом наименьшая доля маглорожденных на факультете
слизерин, а максимальная на гриффиндоре.
hogwarts |>
filter (bloodStatus %in% c ("muggle-born", "pure-blood")) |>
ggplot ()+
bar_cust+
theme_minimal()+
theme_custom +
geom_hline(yintercept = 0.5,
linetype = "dashed",
linewidth = 2,
colour = "#218")+
scale_y_continuous(labels = scales::percent)+
scale_fill_discrete ( name= "Происхождение", labels = c("маглорожденные", "чистокровные"))+
labs(x ="Факультет", y = "Доля студентов (%)")
ggplot(hogwarts)+
geom_boxplot(aes(y = `week_3`,
x = fct_reorder(house, week_3, .desc=TRUE)),
colour = "#128")+
scale_x_discrete(name = "house")+
theme_minimal()+
theme_custom
ggplot(hogwarts)+
geom_boxplot(aes(y = `week_3`,x = fct_reorder(house, week_3,.desc=TRUE), fill = bloodStatus),
colour = "#128",
notch = T)+
theme_minimal()+
theme_custom +
theme(
plot.title = element_text(size = 20, hjust = 0.5),
plot.subtitle = element_text(size = 15, hjust = 0.5)
)+
labs(x ="Факультет", y = "Баллы на 3-ей неделе обучения") +
scale_fill_brewer(name= "Происхождение", labels = c("полукровки","маглорожденные", "чистокровные"), palette = "Accent")
bp_3 <-hogwarts |> ggplot(aes(x = fct_reorder(house, week_3, .desc = TRUE ), y = week_3 , fill = bloodStatus))+
geom_boxplot(colour = "#128",notch = T, outliers = F,varwidth= T, linewidth = 0.3)+
geom_jitter(colour = "tomato", alpha = 0.5)+
labs(x ="Факультет", y = "Баллы на 3-ей неделе обучения", title = "Пример графика для количественной и качественных переменных",
subtitle = "Баллы на 3 неделе обучения",
caption = "Для курса по биостатистике")+
scale_fill_brewer(name= "Происхождение", labels = c("полукровки","маглорожденные", "чистокровные"), palette = "Accent")
bp_3+
theme_bw()+
theme_custom+
theme(
plot.title = element_text(size = 20, hjust = 0.5),
plot.subtitle = element_text(size = 15, hjust = 0.5)
)
hogwarts |>
filter(course == 5) |>
mutate(id = as.factor(id)) |>
ggplot()+
geom_segment(aes(x = fct_reorder(id,result, .desc = TRUE),
xend = fct_reorder(id, result, .desc = TRUE),
y = 0,
yend = result))+
geom_point(aes(x = fct_reorder(id, result, .desc = TRUE),
y = result, colour = wandCore),
size = 3)+
labs(x = "id", y = "result",
title = "Пример 'леденцового' графика",
subtitle = "Результат за год"
)+
theme_bw()+
theme(
plot.title = element_text(size = 20, hjust = 0.5),
plot.subtitle = element_text(size = 15, hjust = 0.5)
)+
scale_color_manual(values = c("dragon heartstring" = "red",
"phoenix feather" = "yellow",
"unicorn hair" = "grey70"))
ggplot(hogwarts)+
geom_histogram(aes(x = `Astronomy exam`, fill = (house == "Slytherin")),
colour = "grey49",
bins = ceiling(log2(nrow(hogwarts))+1))+
labs (y = "Number of students") +
scale_fill_discrete (name = "House", labels = c("TRUE"= "Slytherine", "FALSE" = "Other")) +
theme_bw()+
theme(
axis.text = element_text(size = 18),
axis.title.x = element_text(size = 22),
axis.title.y = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 18)
)
# bp_3 boxplot, полученный в п. 3 с серым фоном
theme_custom_mod <- theme(
panel.background = element_rect(fill = "white", colour = NA),
panel.border = element_rect(fill = NA, colour="grey50"),
panel.grid.major = element_line(colour = "grey90", size = 0.2),
panel.grid.minor = element_line(colour = "grey98", size = 0.5),
panel.margin = unit(0.25, "lines"),
legend.background = element_rect(colour=NA),
legend.key.size = unit(1.2, "lines"),
legend.position = "right",
axis.text = element_text(size = 18),
axis.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 18),
plot.title = element_text(size = 20, hjust = 0.5),
plot.subtitle = element_text(size = 15, hjust = 0.5),
strip.background = element_rect(fill = "grey80", colour = "grey50"),
strip.text.x = element_text(size = 12),
strip.text.y = element_text(size = 12, angle = -90)
)
bp_3 + theme_custom_mod #boxplot, полученный в п. 3 с применением одной кастомизированной темы
На мой вгляд, для визуазации гистограммы как правило лучше
использовать фасетирование по столбцам, так как при таком фасетировании
лучше визуалируются различия по высоте бинов, по строкам форма
распределения “сглаживается” за счет сокращения диапазона, особенно при
небольшом количестве бинов .
Для violin-plot, как мне кажется, чаще подходит фасетирование по
строкам, так как по оси Y отложена плотность вероятности, которая будет
при таком способе визуализироваться лучше (осбенно если сравниваемых
групп много), а при фасетировании по столбацам растягиваться и
сглаживаться и форма распределения будет сложно отличима.
Общее правило: если визулизируем форму распределения, ось, по которой отложены значения вероятности должна быть длинее. В зависимости от этого условия выбирать фасетирование. При фасетировании по столбцам лучше выглядят типа графиков, где количество/вероятность отложена по вертикальной оси (Y) и количество сравниваемых групп небольшое. При фасетировании по строкам - лучше выглядят формы графиков, где вероятность спроецирована по горизонтальную ось (X).
ggplot(hogwarts)+
geom_violin(aes(y = `result`, x= `course`),
fill = "tan1",
colour = "grey49",
bins =40)+
facet_grid(house~.)+
theme_custom
ggplot(hogwarts)+
geom_violin(aes(y = `result`, x= `course`),
fill = "tan",
colour = "grey49",
bins = 40)+
facet_grid(~house)+
theme_custom_mod
ggplot(hogwarts)+
geom_histogram(aes(x = `Herbology exam`),
fill = "wheat4",
bins = ceiling(log2(nrow(hogwarts))+1))+
labs (y = "Number of students") +
facet_wrap (vars (course)) +
theme_custom_mod
ggplot(hogwarts)+
geom_density(aes(x = `Defence against the dark arts exam`),
fill = "plum3",
colour = "grey49",
alpha = 0.5,
bins = ceiling(log2(nrow(hogwarts))+1000))+
geom_density(aes(x = `Herbology exam`),
fill = "forestgreen",
colour = "grey49",
alpha = 0.5,
bins = ceiling(log2(nrow(hogwarts))+1))+
scale_x_continuous(limits = c(-15, 100))+
theme_custom_mod+
facet_grid(~sex)